{-# LANGUAGE RankNTypes                  #-}
{-# LANGUAGE ExistentialQuantification   #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Language.Dependencies.GUI.Types
-- Copyright   :  (c) 2009--2010 TU Dortmund
-- License     :  BSD3
--
-- Maintainer  :  menge@udo.cs.uni-dortmund.de
-- Stability   :  experimental
-- Portability :  non-portable
--
-- contains all relevant data types for the GUI: AstActions, AstState etc. 
-- together with some setters and getters for the GUI-state.
--
-----------------------------------------------------------------------------


module Language.Dependencies.GUI.Types where

-- base
import Data.Tree (Tree(..))
import Data.IORef

-- gtksourceview
import Graphics.UI.Gtk hiding (Language,get)
import Graphics.UI.Gtk.SourceView (SourceBuffer) 
 
-- local
import Language.Dependencies.Language
import Language.Dependencies.References

type AstAction a = IORef AstState -> IO a

-- |union of intern program state and gui
data AstState = AstState
  { state :: State     -- ^ internal program state
  , gui :: GUI         -- ^ gtk data types
  , options :: Options -- ^ global program options
  }

-- |data type for global options
data Options = Options
  { font :: String -- ^ font name of textbuffer
  , fsize :: Int -- ^ font size of textbuffer
  , knownCompareIds :: [CompareId] -- ^ ids of all known comparison functions
  , check :: Relation -> IO Bool
  }

-- |data type for the intern program state
data State =  State
  { cFile :: (String,String) -- ^ current file
  , textchanged :: (Bool,Bool) -- ^ true if file changed
  , configChanged :: Bool -- ^ true if config has been changed
  , cpath :: (GtkPath,GtkPath) -- ^ current paths
  , languages :: forall a .  [Language] -- ^ known languages
  , configFile :: FilePath -- ^ path of current configuraton file 
  }

-- |main gui data type, contains gtk components
data GUI = GUI
  { window :: Window -- ^ main window
  , tv :: (TreeView,TreeView) -- ^ treeview
  , sb :: (SourceBuffer,SourceBuffer) -- ^ sourceview
  , relstore :: ListStore Relation 
  , tvRels :: TreeView -- ^ treeview showing relations
  , dlgAbout :: AboutDialog -- ^ about dialog
  , lblFilename :: (Label,Label)
  }
  
-- |a new type for gtkpath to gain more type safety
data GtkPath = GtkPath [Int] deriving (Show, Eq,Ord)

toGtkPath :: DPath -> GtkPath
toGtkPath (DPath p) = GtkPath $ 0:p

toDPath :: GtkPath -> DPath 
toDPath (GtkPath (0:xs))  = DPath xs
toDPath (GtkPath p)       = 
  error $ "GtkPath "++ show p++" can not be converted to a DPath"


-- |indicator data type for both areas
data Area = L -- ^ left area 
          | R -- ^ right area
         
instance Show Area where
  show L = "left"
  show R = "right"         
          
-- * getter functions
getCompareIds :: AstAction [CompareId]
getCompareIds = fmap (knownCompareIds . options) . readIORef

getConfigFile :: AstAction FilePath
getConfigFile = fmap (configFile . state) . readIORef

getStoreRelation :: AstAction (ListStore Relation)
getStoreRelation = fmap (relstore . gui) . readIORef 

getTvRelation :: AstAction TreeView
getTvRelation = fmap (tvRels . gui) . readIORef 

getSourceBuffer :: Area -> AstAction SourceBuffer
getSourceBuffer a r = do
  let sel = case a of 
              L -> fst
              R -> snd
  fmap (sel . sb . gui) $ readIORef r

getLabel :: Area -> AstAction Label
getLabel a r = do
  let sel = case a of 
              L -> fst
              R -> snd
  fmap (sel . lblFilename . gui) $ readIORef r

getTreeViews :: AstAction [TreeView]
getTreeViews r = do
  t1 <- fmap (fst . tv . gui) $ readIORef r
  t2 <- fmap (snd . tv . gui) $ readIORef r
  return [t1,t2] 

getTreeView :: Area -> AstAction TreeView
getTreeView L = fmap (fst . tv . gui) . readIORef 
getTreeView R = fmap (snd . tv . gui) . readIORef 

getSourceBuffers :: AstAction [SourceBuffer]
getSourceBuffers r = do
  s1 <- fmap (fst . sb . gui) $ readIORef r
  s2 <- fmap (snd . sb . gui) $ readIORef r
  return [s1,s2] 

getAstState :: AstAction AstState
getAstState = readIORef

-- |returns gui data type
getGui :: AstAction GUI
getGui = fmap gui . readIORef 

getState :: AstAction State 
getState = fmap state . readIORef 

getConfigChanged :: AstAction Bool 
getConfigChanged = fmap (configChanged .state) . readIORef 

getLangs :: AstAction [Language]
getLangs = fmap (languages . state) . readIORef

getChanged :: Area -> AstAction Bool
getChanged L = fmap (fst . textchanged . state) . readIORef
getChanged R = fmap (snd . textchanged . state) . readIORef

getPath :: Area -> AstAction GtkPath
getPath L = fmap (fst . cpath . state) . readIORef
getPath R = fmap (snd . cpath . state) . readIORef

getFile :: Area -> AstAction String
getFile L = fmap (fst . cFile . state) . readIORef
getFile R = fmap (snd . cFile . state) . readIORef

getWindow :: AstAction Window
getWindow = fmap (window . gui) . readIORef

-- * setter functions

setPath :: Area -> GtkPath -> AstAction ()
setPath a cp r = modifyIORef r (f a) where
  f :: Area -> AstState -> AstState
  f a s@(AstState st _ _) = 
    let (ll,rr) = cpath st in 
    case a of 
      L -> s { state = st {cpath = (cp,rr)}}
      R -> s { state = st {cpath = (ll,cp)}}

setcFile :: Area -> FilePath -> AstAction ()
setcFile a file r = modifyIORef r (f a) where
  f a s@(AstState st _ _) = 
    let (ll,rr) = cFile st in 
    case a of 
      L -> s { state = st {cFile = (file,rr)}}
      R -> s { state = st {cFile = (ll,file)}}

setChanged :: Area -> Bool -> AstAction ()
setChanged a b r = modifyIORef r (f a) where
  f :: Area -> AstState -> AstState
  f a s@(AstState st _ _) = 
    let (ll,rr) = textchanged st in 
    case a of 
      L -> s { state = st {textchanged = (b,rr)}}
      R -> s { state = st {textchanged = (ll,b)}}

setConfigFile :: FilePath -> AstAction ()
setConfigFile fp r = modifyIORef r f where
  f :: AstState -> AstState
  f s@(AstState st _ _) = s { state = st { configFile = fp }}

setConfigChanged :: Bool -> AstAction ()
setConfigChanged b r = modifyIORef r  f where
  f :: AstState -> AstState
  f s@(AstState st _ _) = s { state = st { configChanged = b }}
